home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / POINTERS.SWG / 0027_Stacks.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-25  |  10KB  |  318 lines
  1. {
  2. From: Deavon@sound.demon.co.uk (Deavon Edwards)
  3.  
  4. I am having some problem with this program. I would like to modified it to
  5. do the following....
  6.  i). To simulate the operation of a queue (Last In First Out).
  7.  ii) To use a linked list instead of arrays(simulating a stack and queue).
  8. If anyone out there can help it would be greatly appreciated.
  9.  
  10.  This program will simulate the operation of a stack and a queue with a
  11.  10 items maximum. It will give the user the opportunity to insert and
  12.  delete items from the data structures, display the data on screen,
  13.  it on a printer, and save and load the data from a disk
  14. }
  15.  
  16. PROGRAM StackSimulation(input, output);
  17.  
  18. USES CRT,DOS,PRINTER;
  19.  
  20. VAR
  21.   Stack      : ARRAY [1..10] OF STRING[20];
  22.   StackFull  : BOOLEAN;
  23.   StackEmpty : BOOLEAN;
  24.   Pointer    : INTEGER;
  25.   Choice     : CHAR;
  26.  
  27.     {*******************************************************************}
  28.  
  29. PROCEDURE PressAKey;
  30. BEGIN
  31.  
  32.   WRITELN;
  33.   WRITELN;
  34.   WRITELN ('                 ************************************');
  35.   WRITELN ('                 ***   PRESS RETURN TO CONTINUE   ***');
  36.   WRITELN ('                 ************************************');
  37.   READLN;
  38.   CLRSCR;
  39. END;
  40.     {*******************************************************************}
  41. PROCEDURE Jump_a_Line(Jump: INTEGER);
  42. VAR
  43.    Skip : INTEGER;
  44.  
  45. BEGIN
  46.    FOR Skip := 1 TO Jump DO
  47.    WRITELN;
  48. END;
  49.     {*******************************************************************}
  50.  
  51. Procedure Introduction;              {Display an introduction message to user}
  52.   BEGIN
  53.   CLRSCR;
  54.   gotoxy (1,10);
  55.   Textcolor(Cyan);
  56.   writeln('        ********************************************************');
  57.   writeln('        ********************************************************');
  58.   writeln('        *                                                      *');
  59.   writeln('        *     WELCOME TO STACK & QUEUE SIMULATION PROGRAM      *');
  60.   writeln('        *                                                      *');
  61.   writeln('        ********************************************************');
  62.   writeln('        ********************************************************');
  63.   Jump_a_line(3);
  64.   DELAY (1000);
  65.   end;
  66.  
  67.     {*******************************************************************}
  68.  
  69. PROCEDURE Initialise (VAR StackFull, StackEmpty : BOOLEAN);
  70.  
  71. BEGIN
  72.   CLRSCR;
  73.   gotoxy (1,10);
  74.   Jump_a_line(2);
  75.   WRITELN ('        ******************************************************');
  76.   WRITELN ('        THE STACK IS INITIALISING...........PLEASE WAIT.......');
  77.   WRITELN ('        ******************************************************');
  78.   Jump_a_line(3);
  79.   SOUND (240);
  80.   DELAY (1000);
  81.   CLRSCR;
  82.   NOSOUND;
  83.   Pointer := 0;
  84.   StackFull := FALSE;
  85.   StackEmpty := TRUE;
  86. END;
  87.  
  88.     {*******************************************************************}
  89.  
  90. PROCEDURE Add (VAR StackFull, StackEmpty : BOOLEAN);
  91. BEGIN
  92.  IF StackFull THEN
  93.    BEGIN
  94.      gotoxy (1,10);
  95.      Jump_a_line(2);
  96.      WRITELN ('************************************************************');
  97.      WRITELN ('** SORRY, THE STACK IS FULL, NO MORE DATA CAN BE ENTERED ***');
  98.      WRITELN ('************************************************************');
  99.      Jump_a_line(3);
  100.      PressAKey;
  101.    END
  102.  ELSE
  103.    BEGIN
  104.      INC (Pointer);
  105.      Jump_a_line(3);
  106.      WRITE ('PLEASE ENTER THE ITEM TO BE ADDED TO THE STACK :=>  ');
  107.      READLN (Stack [Pointer]);
  108.      CLRSCR;
  109.      IF StackEmpty THEN StackEmpty := FALSE;
  110.      IF Pointer = 10 THEN StackFull := TRUE;
  111.    END;
  112. END;
  113.  
  114.     {*******************************************************************}
  115.  
  116. PROCEDURE Take (VAR StackFull, StackEmpty : BOOLEAN);
  117. BEGIN
  118.   IF StackEmpty THEN
  119.     BEGIN
  120.       gotoxy (1,10);
  121.       Jump_a_line(3);
  122.       WRITELN ('    *******************************************************');
  123.       WRITELN ('    *** THE STACK IS EMPTY, NO MORE DATA CAN BE REMOVED ***');
  124.       WRITELN ('    *******************************************************');
  125.       Jump_a_line(3);
  126.       PressAKey;
  127.     END
  128.   ELSE
  129.     BEGIN
  130.       gotoxy (1,10);
  131.       Jump_a_line(3);
  132.       WRITE ('THE FOLLOWING ITEM HAVE BEEN REMOVE FROM THE STACK :=>  ');
  133.       WRITELN (Stack [Pointer]);
  134.       DEC (Pointer);
  135.       IF Pointer = 0 THEN StackEmpty := TRUE;
  136.       IF StackFull THEN StackFull := FALSE;
  137.       Jump_a_line(3);
  138.       PressAKey;
  139.     END;
  140. END;
  141.  
  142.     {*******************************************************************}
  143.  
  144. PROCEDURE Display_to_Screen (StackEmpty : BOOLEAN);
  145. VAR
  146.   Counter : INTEGER;
  147. BEGIN
  148.   CLRSCR;
  149.   GOTOXY (1,10);
  150.   IF StackEmpty THEN
  151.     WRITELN ('                      THE STACK IS CURRENTLY EMPTY ');
  152.     Jump_a_Line (3);
  153.   FOR Counter := 1 TO Pointer DO
  154.   WRITELN (Counter:2 ,'     ', Stack [Counter]);
  155.   Jump_a_Line(2);
  156.   PressAKey;
  157. END;
  158.  
  159.     {*******************************************************************}
  160. PROCEDURE Print_to_Printer (StackEmpty : BOOLEAN);
  161. VAR
  162.   Counter : INTEGER;
  163. BEGIN
  164.   CLRSCR;
  165.   GOTOXY (1,10);
  166.   {$I-}
  167.   WRITELN (lst,#0);
  168.   IF IORESULT <> 0 THEN
  169.   WRITELN ('       >>>>>>   PRINTING ERROR.......PRINTER OFF LINE   <<<<<<  ')
  170.   ELSE
  171.    BEGIN
  172.     IF StackEmpty THEN
  173.     WRITELN ('THE STACK IS CURRENTLY EMPTY, THERE IS NO DATA TO BE PRINTED.')
  174.     ELSE
  175.     WRITELN (' THE CONTENTS OF THE STACK IS PRINTING........');
  176.     FOR Counter := Pointer DOWNTO 1 DO
  177.     WRITELN (Lst,Counter:2 ,'     ', Stack [Counter]);
  178.    END;
  179.    {$I+}
  180.    PressAKey;
  181. END;
  182.  
  183.  
  184.       {****************************************************}
  185.  
  186. PROCEDURE Save_to_File;
  187.  
  188. VAR
  189.     Write_to_File       : TEXT;
  190.     Output_to_File      : STRING[20];
  191.     Read_File           : BOOLEAN;
  192.     Counter             : INTEGER;
  193.  
  194. BEGIN
  195.   CLRSCR;
  196.   Jump_a_Line(3);
  197.   WRITE('PLEASE ENTER THE NAME YOU WISH TO CALLED THE FILE :=> ');
  198.   READLN(Output_to_File);
  199.   ASSIGN(Write_to_File,Output_to_File);
  200.   REWRITE(Write_to_File);
  201.   FOR Counter := 1 TO Pointer DO
  202.     BEGIN
  203.       Writeln(Write_to_File,Stack[Counter]);
  204.       Writeln('SAVING... ',Counter:2,' ... ',Stack[Counter]);
  205.     END;
  206.     CLOSE(Write_to_File);
  207.     PressAKey;
  208. End;
  209.  
  210.                 {**************************************************}
  211.  
  212. PROCEDURE Open_A_File (StackEmpty : BOOLEAN);
  213.  
  214. VAR
  215.     Read_File       : TEXT;
  216.     Input_to_File   : STRING[20];
  217.  
  218.  BEGIN
  219.    CLRSCR;
  220.    Jump_a_Line(3);
  221.    WRITE ('PLEASE ENTER THE NAME OF THE FILE YOU WHICH TO OPENED :=> ');
  222.    READLN(Input_to_File);
  223.    ASSIGN(Read_File,Input_to_File);
  224.    {$I-}
  225.    RESET(Read_File);
  226.    IF IOResult = 0 THEN
  227.     BEGIN
  228.      Jump_a_Line(2);
  229.      Pointer := 0;
  230.      WHILE NOT EOF(Read_File) DO
  231.        BEGIN
  232.          INC (Pointer);
  233.          READLN(Read_File,Stack [Pointer]);
  234.          WRITELN(Pointer:2,' : ',Stack[Pointer]);
  235.        END;
  236.        CLOSE(Read_File);
  237.        StackEmpty := FALSE;
  238.        END
  239.        ELSE
  240.        CLRSCR;
  241.        Jump_a_Line(2);
  242.        WRITELN ('                 ***********************************');
  243.        WRITELN ('                 ***   FILE NAME DOES NOT EXIT   ***');
  244.        WRITELN ('                 ***********************************');
  245.        {$I+}
  246.        PressAKey;
  247. END;
  248.  
  249.                {****************************************************}
  250.  
  251. PROCEDURE Menu;
  252.  
  253.  BEGIN
  254.     gotoxy (1,10);
  255.     Textcolor(White);
  256.     WRITELN ('           **************************************************');
  257.     WRITELN ('           **************************************************');
  258.     WRITELN ('           ****       A : Add to Stack                  *****');
  259.     WRITELN ('           ****       T : Take from Stack               *****');
  260.     WRITELN ('           ****       D : Display Stack List to Screen  *****');
  261.     WRITELN ('           ****       P : Print Stack List              *****');
  262.     WRITELN ('           ****       I : Initialise Stack List         *****');
  263.     WRITELN ('           ****       S : Save Stack to disk            *****');
  264.     WRITELN ('           ****       L : Load Stack from disk          *****');
  265.     WRITELN ('           ****       Q : Quit program                  *****');
  266.     WRITELN ('           **************************************************');
  267.     WRITELN ('           **************************************************');
  268.     WRITELN;
  269.     WRITELN;
  270.     WRITELN ('           PLEASE ENTER AN OPTION >> ');
  271.     Choice := READKEY;
  272.  
  273.  END;
  274.  
  275. PROCEDURE QuitProgram;
  276.  
  277. BEGIN
  278.   gotoxy (1,10);
  279.   WRITELN ('                  ***********************************');
  280.   WRITELN ('                  """""""""""""""""""""""""""""""""""');
  281.   WRITELN ('                  [[[[[      GOODBYE!!!!!!     ]]]]] ');
  282.   WRITELN ('                  """""""""""""""""""""""""""""""""""');
  283.   WRITELN ('                  ***********************************');
  284.   WRITELN;
  285.   WRITELN;
  286. END;
  287.  
  288.     {*******************************************************************}
  289.     {*******************************************************************}
  290.  
  291. BEGIN
  292.    Introduction;
  293.    Initialise (StackFull, StackEmpty);
  294.   REPEAT
  295.     Menu;
  296.     CLRSCR;
  297.     CASE Choice OF
  298.      'A', 'a' : Add (StackFull, StackEmpty);
  299.      'T', 't' : Take (StackFull, StackEmpty);
  300.      'D', 'd' : Display_to_Screen (StackEmpty);
  301.      'P', 'p' : Print_to_Printer (StackEmpty);
  302.      'I', 'i' : Initialise (StackFull, StackEmpty);
  303.      'S', 's' : Save_to_File;
  304.      'L', 'l' : Open_a_File(StackEmpty);
  305.      'Q', 'q' : QuitProgram
  306.     ELSE
  307.       BEGIN
  308.         gotoxy (1,10);
  309.         WRITELN ('                       **************************');
  310.         WRITELN ('                       **  Invalid key pressed **');
  311.         WRITELN ('                       **************************');
  312.         WRITELN;
  313.         PressAKey;
  314.       END;
  315.     END;
  316.   UNTIL (Choice = 'Q') OR (Choice = 'q');
  317. END.
  318.